00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES. LOAD WITH MSFAIL.FAI
00200		COMMON/STF/RSTFAC(-3/4),RSTJ2 /XXX/LK,LP,JY
00300		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00400		COMMON/XRN/RN(2000) /SF/KL,RT,KP,STFSZ,NAMX
00500		COMMON/POSI/STFF(-3/4),JJ2,PQ/PTR/PWDS(250),L,LL,I,IX
00600	      DIMENSION IV(78),LIST(200),XLAST(4)
00700		1,XWDS(150)
00800	C**** RN MIGHT HAVE TO BE 4000 ******
00900		COMMON /PX/SX,PN(1800),Q(9000)
01000		DATA FIB/.7/,RSPC/24./
01100		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
01200		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(LIST,IV)
01300	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
01400	
01450		YN=0
01500		XSIG=FIB
01600		CLEF=FIB
01700		XMTR=FIB
01800		XLFT=0
01900		ENDLN=0
02000		KQ=0
02100		YCLEF=2.
02200		YSIG=2.
02300		YMTR=2.
02400	14	LSTNM=0
02500	13	XWDS(1)=1
02600		IF(LSTNM.EQ.0)RM=0
02700		L=1
02800		LK=1
02900		IF(LSTNM.NE.0)GO TO 87
03000		RS=3
03100	C  SAVE UPPER STAFF NUM FOR NEXT FILE.
03200		TYPE 144
03300	144	FORMAT(' STAFF SIZE = '$)
03400		ACCEPT 5,STFSZ
03500		IF(STFSZ.EQ.0)STFSZ=.9
03600	C  NON-ZERO STFSZ WILL CHANGE P5 IN ALL USED STAVES.
03700	10	IF(LSTNM.EQ.0)GO TO 83
03800	87	IF(NAME.EQ.LSTNM)GO TO 83
03900		NAME=NAME+2
04000		GO TO 84
04100	86	FORMAT(1XA5)
04200	3	FORMAT(' TYPE INPUT NAME  ',$)
04300	300	FORMAT(' TYPE FINAL NAME  ',$)
04400	83	TYPE 3
04500		ACCEPT 2,NAME
04600		IF(NAME.EQ.' ')GO TO 83
04700		IF(NAME.EQ.'X')GO TO 20
04800	C*************  TYPE 'X' TO FINISH  *****************
04900		TYPE 300
05000		ACCEPT 2,LSTNM
05100	CC	IF(LSTNM.EQ.' ')LSTNM=NAME
05200		IF(LSTNM.EQ.' ')GO TO 83
05300		NAMZ=NAME
05400	84	IF(LOOKD(NAME))GO TO 284
05500		NAME=NAMZ+256
05600		IF(LOOKD(NAME).GE.0)GO TO 83
05700		NAMZ=NAME
05800	C  FOUND NO MORE TO READ
05900	284	TYPE 86,NAME
06000		JZ=0
06100		IF(RM.NE.0)GO TO 77
06200		RM=-1
06300	4	FORMAT(' TYPE INST NAME  '$)
06400		TYPE 4
06500		ACCEPT 2,RNAM
06600	C  TYPE ANY NUM AFTER INS. NAME TO STOP RHYTH RESPACING.
06700		IF(RNAM.GT.0)REREAD 5,SN
06800		IF(INM.EQ.'99')GO TO 20
06900	CC	K=SN/100.
07000		TYPE 46
07100	46	FORMAT(' TRANS. NUM. -- '$)
07200		ACCEPT 5,TR
07300	C  TRANSPOSITION BY STEPS
07400		IF(TR.GE.99)GO TO 83
07500	77	REWIND 21
07600	177	CALL IFILE(21,NAME)
07700	C  LP IS START OF RN ARRAY THIS TIME
07800		READ(21),ITEM,I,
07900		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
08000		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
08200		DO 45 K=1,ITEM
08300		J=PWDS(K)
08400		IF(RN(J+1).NE.8)GO TO 45
08500		XLFT=RN(J+3)
08600		IF(RNAM)GO TO 145
08700	C GO TO 145 IF IT'S A NAME, NOT A NUMB.
08800		IF(RN(J+2).EQ.SN)GO TO 8 
08900		GO TO 45
09000	145	R9=RN(J+9)
09100		TYPE 86,R9
09200		IF(R9.NE.RNAM)GO TO 45
09300		SN=RN(J+2)
09400	C LEFT LIMIT OF STAFF
09500	C FOR FIRST BAR LINES.
09600	CC	IF(STFSZ.EQ.0)STFSZ=RSTFAC(IFIX(SN))
09700	C  FOUND THE STAFF
09800		GO TO 8
09900	45	CONTINUE
10000		SN=200
10100		TYPE 16
10200		IF(YN.EQ.'G')GO TO 10
10300	C  TYPE 'G' FOR "GO" -- WON'T WAIT FOR RESPONSE ANYMORE.
10400		ACCEPT 2,YN
10500		IF(YN.NE.'Y')GO TO 10
10600	16	FORMAT(' INST. NOT FOUND --- ADD BARS REST? Y-N?  ',$)
10700		IF(YCLEF.GT.1)YCLEF=-1
10800		IF(YSIG.GT.1)YSIG=-1
10900		IF(YMTR.GT.1)YMTR=-1
11000		GO TO 450
11100	8	SIG=200
11200	C  FOR TRANSP. SECTION.
11300		RN(J+8)=0
11400	C REMOVES VERTICAL SPACER, IF ANY
11500		IF(RS.EQ.0)RN(J+8)=2.95
11600	C  PUTS ONE IN IF THIS IS LAST ONE FOR THIS FILE.
11700	
11800	450	ZLFT=XLFT+.5
11900	CC	RPOS=XLFT
12000		DO 6 K=1,ITEM
12100		J=PWDS(K)
12200		R=RN(J+1)
12300		IF(R.NE.10)GO TO 800
12400		IF(RN(J).LT.4)GO TO 80
12500		IF(RN(J+6).GT.1.3)GO TO 6
12600	C  SKIPS PAGE NUMS. (I.E. BIG SIZE)
12700		IF(RN(J).LT.6)GO TO 80
12800	C  FOUND A NUM. IN BOX ↓↓
12900	CC2182	RN(J+2)=SN
13000	CC	IF(YN.EQ.'Y')RPOS=RN(J+3)-3.
13100		GO TO 810
13200	800	IF(R.NE.4)GO TO 80
13300	CCC	IF(NBAR)GO TO 80
13400		IF(RN(J).NE.2)GO TO 182
13500	C  FOUND A BAR LINE
13600		IF(RN(J+3).LT.ZLFT)GO TO 6
13700	C DROPS BAR LINE AT LEFT OF STAFF.
13800		KZ=RN(J+4)/100.
13900		RN(J+4)=1.+KZ*100.
14000	C  KZ IS FOR THICK BARS.
14100		RR=RN(J+3)
14200		DO 82 KY=K+1,ITEM
14300		KZ=PWDS(KY)
14400		IF(RN(KZ+1).NE.4)GO TO 82
14500		IF(RN(KZ).NE.2)GO TO 82
14600	C  AVOIDS DUPLICATE BARS.
14700		IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82	
14800		RN(KZ+2)=99
14900		RN(KZ+1)=0
15000	82	CONTINUE
15100		IF(YN.NE.'Y')GO TO 810
15200		CALL ADDRST(RR,XWDS,PN)
15300		GO TO 6
15400	182	RN(J+1)=44
15500	C  CHANGES CODE NUM 
15600		IF(RN(J).LT.5)GO TO 80
15700		IF(RN(J+7).GE.3)GO TO 6
15800	C  SKIP HEAVY BRACKETS.
15900	80	RSN=RN(J+2)
16000	C  THE STAFF NUM.
16100	CC80	IF(RN(J+2).NE.SN)GO TO 6
16200		IF(R.NE.3)GO TO 3801
16300		IF(YCLEF)GO TO 4801
16400		IF(RSN.NE.SN)GO TO 6
16500	4801	RR=RN(J+5)
16600		IF(RN(J).LT.3)RR=0
16700		IF(RR.EQ.CLEF)GO TO 6
16800	C SKIP DUPLICATE CLEFS.
16900		IF(RR.GT.3)GO TO 4800
17000		CLEF=RR
17100	C**	IF(YCLEF.EQ.1)GO TO 4802
17200	C**	IF(YCLEF)YCLEF=1.
17300		YCLEF=0
17400		GO TO 1800
17500	4800	IF(RSN.NE.SN)GO TO 6
17600		RN(J+1)=33
17700		GO TO 1800
17800	4802	YCLEF=0
17900	C  CATCHES CLEF AFTER FIRST RESTS.
18000		GO TO 6
18100	3801	IF(R.NE.17)GO TO 3800
18200		IF(YSIG)GO TO 3802
18300		IF(RSN.NE.SN)GO TO 6
18400	3802	IF(RN(J+5).EQ.XSIG)GO TO 6
18500		YSIG=0
18600		XSIG=RN(J+5)
18700	C SKIPS DUPL. KEY SIGS.
18800		GO TO 1800
18900	3800	IF(R.EQ.8)GO TO 6
19000	C  OMIT ALL STAVES FOR NOW
19100		IF(R.NE.18.)GO TO 81
19200		IF(YMTR)GO TO 1801
19300		IF(RSN.NE.SN)GO TO 6
19400	1801	RA=RN(J+5)*100.+RN(J+6)
19500	C  THE TIME SIG.
19600		IF(XMTR.EQ.RA)GO TO 6
19700		XMTR=RA
19800		YMTR=0
19900		GO TO 1800
20000	81	IF(RSN.NE.SN)GO TO 6
20100	1800	IF(RN(J+3).LT.XLFT)GO TO 6
20200	C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
20300	810	JA=PWDS(K+1)
20400		RN(J+2)=RS
20500		DO 7 KY=J,JA-1
20600		PN(LK)=RN(KY)
20700	7	LK=LK+1
20800		L=L+1
20900		XWDS(L)=LK
21000	6	CONTINUE
21100	
21200	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
21300		I=1
21400		DO 243 K=1,L-1
21500		LB=XWDS(K)+1
21600		IF(PN(LB).NE.16)GO TO 243
21700		IF(PN(LB-1).LT.8)GO TO 243
21800		JL=XWDS(K-1)
21900	244	PN(LB+2)=PN(JL+3)
22000	C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
22100	C  FOR SPACING PROBLEMS BELOW.
22200	243	CONTINUE
22300		M=2
22400		J=1
22500	24	RA=100000.
22600	C  POSITION
22700		DO 21 K=1,L-1
22800		JL=XWDS(K)+3
22900		R=PN(JL)
23000		IF(R.EQ.100000)GO TO 21
23100	241	IF(ABS(R-RA).GT..1)GO TO 240
23200		R=RA
23300		PN(JL)=R
23400	C  PUT IN HERE MULTI-VOICE TRAP
23500		GO TO 21
23600	240	IF(R.GT.RA)GO TO 21
23700	C  LINES THEM UP
23800		I=K
23900		RA=R
24000	21	CONTINUE
24100		IF(RA.EQ.100000)GO TO 23
24200	C  JUMP IF ALL SORTED
24300	242	JL=XWDS(I)
24400		LA=JL
24500		N=PN(JL)+3
24600	C  NEXT POINTER
24700		PWDS(M)=PWDS(M-1)+N
24800		M=M+1
24900		DO 22 K=J,J+N-1
25000		RN(K)=PN(JL)
25100	22	JL=JL+1
25200		PN(LA+3)=100000
25300	C  PUT IT ASIDE
25400		J=N+J
25500		GO TO 24
25600	
25700	23	IF(ENDLN.EQ.0)GO TO 2334
25800		R4=0
25900		R5=1000
26000		R7=RS
26100		R8=ENDLN
26200		R9=0
26300		GO TO 33
26400	2334	R4=0
26500		R5=10000
26600	CC	R8=-XLFT
26700		R8=1.-RN(4)
26800		R9=0
26900	C  INSERT??  →→ IF(R8.GT.0)R9=200.
27000		R7=RS
27100	33	CALL PTMOVE(RN,PWDS)
27200		DO 32 K=1,IFIX(PWDS(L))-1
27300		KQ=KQ+1
27400	32	Q(KQ)=RN(K)
27500		ENDLN=ENDLN+200
27600		L=1
27700		LK=1
27800		TYPE 3001,KQ
27900		GO TO 10
28000	
28100	27	FORMAT(' RESPACING')
28200	20	K=1
28300		TYPE 27
28400		KK=1
28500	220	JJ=Q(K)+3
28600		PN(KK)=K
28700	C NEW POINTER
28800		K=K+JJ
28900		KK=KK+1
29000		IF(K.LT.KQ)GO TO 220
29100		PN(KK)=K
29200		TYPE 3001,KK
29300		L=KK
29400	C  DELETES EXTRA BAR LINES, ETC.
29500		CALL RESTS(PN,Q)
29600	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
29700		K=1
29800		L=1
29900		LL=0
30000		LK=1
30100	221	IF(Q(IFIX(PN(K))+1))GO TO 321
30200		DO 421	 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
30300		LL=LL+1
30400	421	Q(LL)=Q(KL)
30500		LK=LK+1
30600		PN(LK)=LL+1
30700	321	K=K+1
30800		IF(K.LT.KK)GO TO 221
30900		L=LK-1
31000	C  L=NUMBER OF ITEMS FOR RHY RECONS.
31100	123	LB=1 
31200		LL=0
31300		R5X=0
31400	C  NEXT RECONSTITUTES RHYTHM
31500		LP=1
31600	25	N=PN(LB)
31700		R=Q(N+1)
31800		IF(TR.EQ.0)GO TO 51
31900		IF(R.EQ.1)GO TO 52
32000		IF(R.EQ.5)GO TO 52
32100		IF(R.EQ.6)GO TO 52
32200		IF(R.EQ.17)GO TO 117
32300	51	PR=0
32400		IF(R.LE.4)GO TO 430
32500		IF(R.LT.17)GO TO 30
32600	C LOOKS FOR 17 AND 18, KSIG AND METER.
32700		IF(R.GT.18)GO TO 30
32800	430	IF(R.NE.1)GO TO 230
32900		IF(Q(N).LT.7)GO TO 630
33000		IF(Q(N+9))GO TO 30
33100	C SKIPS NON-LEDGER LINE NOTES.
33200		GO TO 130
33300	630	PR=1.
33400		IF(Q(N+8).EQ.1000.)PR=.05
33500	C  ↑↑↑↑ FOR GRACE NOTES
33600		GO TO 130
33700	C  LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS, AND BARS,CLEFS
33800	230	IF(R.NE.2)GO TO 130
33900		IF(Q(N).LT.5)PR=1.
34000	C JUMP IF NO RHYTH VALUE FOUND IN P7 (P9 FOR NOTES)
34100	CC130	IF(RCLEF(Q(N)))GO TO 30
34200	CJ SKIPS NON-CLEFS
34300	130	S=Q(N+3)
34400		LA=LB
34500	26	LA=LA+1
34600		IF(LA.GT.L)GO TO 30
34700	C  FIND NEXT IMPORTANT ITEM
34800		NA=PN(LA)
34900		RR=Q(NA+1)
35000		IF(RR.LE.4)GO TO 134
35100		IF(RR.LT.17)GO TO 26
35200		IF(RR.GT.18)GO TO 26
35300	CC134	IF(RR.NE.4)GO TO 34
35400	CC	IF(Q(NA).NE.2)GO TO 26
35500	C  USES ONLY NOTES, RESTS, BARS, CLEFS
35600	CC34	IF(RCLEF(Q(NA)))GO TO 26
35700	CJ SKIPS NON-CLEFS
35800	134	RX=Q(NA+3)
35900	C  POSITION OF NEXT ITEM
36000		IF(S.EQ.RX)GO TO 26
36100		IF(R.LT.3)GO TO 235
36200		IF(R.GE.17)P=4.
36300	C  PUT IN FOR LARGE KSIGS LATER.
36400		IF(R.EQ.4)P=2.
36500		IF(R.EQ.3)P=6.
36600		IF(Q(NA+5).GE.100.)P=5.
36700	C SPACE FOR BARS, KSIG, METERS, CLEFS (LAST FOR MINI-CLEF)
36800		IF(RR.EQ.17)P=P+3.
36900	C  IF NEXT(RR) IS KSIG, ADD SPACE.
37000		GO TO 335
37100	235	K=9
37200		IF(R.EQ.2)K=7
37300		P=Q(N+K)
37400		IF(PR.NE.0)P=PR
37500	C  ASSUMES QUARTER VALUE IF NONE WAS GIVEN
37600		P=P+(.125-P)*FIB
37700	135	P=P*RSPC
37800	C  FINDS RHYTH IN P9 OR P7(REST)
37900	C  IF DIFFERENT SIMULTANEOUS RHYTHMS, ZERO OUT LARGER BEFORE HAND.
38000		IF(P)GO TO 30
38100	C  SKIPS NOTES WITH SUPPRESSED LEDGER LINES.
38200	335	SX=S+P-RX
38300		R5X=R5X+SX
38400	C  SPACE DIFFERENCE
38500	
38600		R7=RS
38700		IF(SX.LT.-.5)GO TO 29
38800		IF(SX.LT.0.5)GO TO 30
38900	2900	R4=RX
39000		R5=10000.
39100		R8=SX
39200		R9=0
39300	C  ADJUST REST OF LINE
39400		CALL PTMOVE(Q,PN)
39500		IF(SX)GO TO 30
39600	29	R4=S
39700		R5=RX
39800		R8=S
39900		R9=RX+SX
40000	C  ADJUST STUFF BETWEEN POINTS
40100		CALL PTMOVE(Q,PN)
40200		IF(SX)GO TO 2900
40300	
40400	30	LB=LB+1
40500		IF(LB.LT.L)GO TO 25
40600	C  GO BACK IF MORE SPACING TO DO
40700	C***	IF(XLFT.EQ.0)GO TO 600
40800	C  NEXT MOVES LEFT SIDE OF STAFF TO ZERO
40900	CC	R5=10000.
41000	CC	R7=RS
41100	CC	R8=-XLFT
41200	CC	R4=-101
41300	CC	R9=0
41400	CC	CALL PTMOVE(Q,PN)
41500	C***	CALL LINELN
41600	C  BREAKS IT UP INTO LINES.
41700		J=1
41800		CALL OFILE(1,'PX')
41900		LL=PN(L+1)
42000	2929	WRITE(1),L,LL,
42100		1(PN(K),K=1,L+1),(Q(K),K=1,LL-1),NAMX,STFSZ,J,J,RSTFAC,STFF,IV,STFF
42200		STOP
42300	2	FORMAT(A5)
42400	3001	FORMAT(2I6)
42500	5	FORMAT(5F)
42600	
42700	
42800	52	A=Q(N+4)
42900		Q(N+4)=A+TR
43000	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
43100		X=Q(N+5)
43200		IF(Q(N+1).EQ.1)GO TO 11
43300	C  COULD ADD STEM REVERSE HERE.
43400		Q(N+5)=X+TR
43500		GO TO 51
43600	11	A=AMOD(A,100.)
43700		IF(TR.NE.4)GO TO 1101
43800		IF(AMOD(A,7.0).EQ.0)GO TO 101
43900	1101	IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
44000	C  NEXT IS FOR Bb TRANSP.
44100		B=AMOD(A+7.0,7.0)
44200		IF(B.EQ.0)GO TO 101
44300		IF(B.NE.3)GO TO 51
44400	C  FINDS ORIG. E OR B
44500	101	M=AMOD(X,10.0)
44600	C  FINDS ACCID.
44700		X=X-M
44800	C  STEM DIR. AND DECI.
44900		B=3.
45000	C CHANGES FLAT TO NATURAL SIGN.
45100		IF(M.NE.0)GO TO 118
45200		IF(SIG.NE.200)GO TO 51
45300	C  GO BACK IF A KEY SIG. IS PRESENT
45400	118	IF(M.EQ.3)B=2
45500	C  NO PROVISION YET FOR ## OR bb
45600	2101	Q(N+5)=X+B
45700		GO TO 51
45800	117	SIG=Q(N+5)
45900		IF(TR.EQ.1)SIG=SIG+2
46000		IF(TR.EQ.4)SIG=SIG+1
46100	C CHANGE KSIG FOR Bb AND F INSTS.  ADD CHECK-UP ABOVE LATER.
46200	C  MAKES NATURALS IF CHANGED TO NO KSIG (I.E. =0)
46300		IF(SIG.NE.0)GO TO 217
46400		IF(TR.EQ.1)SIG=-102
46500		IF(TR.EQ.3)SIG=-101
46600	217	Q(N+5)=SIG
46700		GO TO 51
46800		END